00100	TITLE PASS3
00200	EXTERNAL TRIBLKS,TRITAB,INPUT3,NUMTRI
00300	INTERNAL PASS3
00400	PASS3:	0
00500		SETZM NLEAST#	;COUNT OF TRIANGLES
00550	OPDEF OUTSTG [XWD 051140,0]
00600	;ACCUMULATORS
00700	A←←XY1←←KA←←0
00800	B←←XY2←←AC0←←LA←←1
00900	C←←XY3←←AC1←←2
01000	AA←←I1←←Z12←←LO←←LB←←KB←←3
01100	BB←←I2←←Z3I←←HI←←4
01200	CC←←I3←←C12←←MID←←5
01300	X1←←AB1←←KC←←6
01400	X2←←AB2←←7
01500	X3←←AB3←←10
01600	Y1←←AB←←11
01700	Y2←←CC3←←12
01800	Y3←←13
01900	Z1←←Z←←14
02000	Z2←←TRI←←15
02100	Z3←←LC←←16
02200	ZT←←QB←←II←←KK←←17
02240	KPLANE←20000
02300	LOOP:	MOVE QB,NLEAST		;DONE YET  
02400		CAML QB,NUMTRI
02500		JRST @PASS3
02600	;BLIT TRIANGLE BLOCK INTO AC'S
02700		IMULI QB,5
02800		ADDI QB,INPUT3
02840		MOVSS QB
02900		BLT QB,4
03000	;UNPACK TRIANGLE BLOCK
03100		FOR @$ I←1,3 {
03200		HLRE X$I,XY$I
03300		HRRE Y$I,XY$I ⎇
03400		HLRE Z1,Z12
03500		HRRE Z2,Z12
03600		HLRE Z3,Z3I
03700		HRRZ II,Z3I
03800	P3B:
03900		TRNE II,4 ↔ SKIPA I1,[1] ↔ SETZ I1,
04000		TRNE II,2 ↔ SKIPA I2,[1] ↔ SETZ I2,
04100		TRNE II,1 ↔ SKIPA I3,[1] ↔ SETZ I3,
04200	P3A:
04300	;ORDER Z1 LEAST, Z3 MOST.
04400	DEFINE SWAP $ (N,M) {
04500	CAMG Z$N,Z$M
04600	JRST .+5
04700	EXCH X$N,X$M
04800	EXCH Y$N,Y$M
04900	EXCH Z$N,Z$M
05000	EXCH I$N,I$M ⎇
05100	SWAP 1,2
05200	SWAP 2,3
05300	SWAP 1,2
05400	
05500	MOVE II,I1	;RE-PACK I-BITS
05600	LSH  II,1
05700	IOR  II,I2
05800	LSH  II,1
05900	IOR  II,I3
06000	
06100	EXCH II,[KPLANE]
     

00100	;CALCULATE COEFFICIENTS OF THE PLANE OF THE TRIANGLE BY KRAMER'S RULE.
00200	DEFINE DET2B2 (A00,B11,B12,B21,B22) {
00300	MOVE B,B11
00400	MOVE C,B12
00500	IMUL B,B22
00600	IMUL C,B21
00700	SUB B,C
00800	IMUL B,A00 ⎇
00900	
01000	DEFINE DETERM (A11,A12,A13,A21,A22,A23,A31,A32,A33) {
01100	DET2B2 A11,A22,A23,A32,A33
01200	MOVE A,B
01300	DET2B2 A12,A21,A23,A31,A33
01400	SUB A,B
01500	DET2B2 A13,A21,A22,A31,A32
01600	ADD A,B ⎇
01700	
01800	DETERM KK,Y1,Z1,KK,Y2,Z2,KK,Y3,Z3
01900	MOVE AA,A
02000	DETERM X1,KK,Z1,X2,KK,Z2,X3,KK,Z3
02100	MOVE BB,A
02200	DETERM X1,Y1,KK,X2,Y2,KK,X3,Y3,KK
02300	MOVE CC,A
02400	DETERM X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
02410	MOVE B,A
02420	MOVE C,A
02500	IDIVM AA,A
02600	IDIVM BB,B
02700	IDIVM CC,C
02710	MOVE CC,C
02720	MOVE BB,B
02730	MOVE AA,A
02731	;HALF WORD OVERFLOW DETECTION, WARNING AND RESET TO MAXIMUM HALF 
02733	;WORD VALUE.
02735	DEFINE HALFOV (W,WW){
02745	MOVMS W,WW
02747	CAIGE W,400000
02749	JRST .+5
02751	SKIPL WW	;OVERFLOW
02753	SKIPA WW,377777
02755	SKIP  WW,400000
02757	OUTSTG [ASCIZ/ HALF-WORD OVERFLOW WARNING.
02759	/]
02761	⎇
02763	HALFOV A,AA
02765	HALFOV B,BB
02767	HALFOV C,CC
02800	P3C:
02900	;PACK PLANE COEFFICIENTS
03000	HRL BB,AA
03100	HRLS CC
03200	EXCH KK,[KPLANE]		;COL-1
03300	
     

03400	;CALCULATE LINE COEFFICIENTS
03500	DEFINE LINCOE (X1,X2,Y1,Y2,TA,TB,TC) {
03600	MOVE TA,Y2
03700	MOVE TB,X1
03800	SUB TA,Y1
03900	SUB TB,X2
04000	HRL TC,TA
04100	HRR TC,TB
04200	IMUL TA,X1
04300	IMUL TB,Y1
04400	ADD TA,TB
04500	MOVNS TA
04510	MOVM TB,TA
04536	CAIGE TB,400000
04538	JRST .+6
04540	HLRE TA,TC	;HALFWORD OVERFLOW CURE
04542	HRRE TB,TC
04544	ASH TA,-1
04546	ASH TB,-1
04548	JRST .-15	;JUMP TO THE  "HRL" ABOVE.
04600	⎇
04700	HRL QB,Z3
04800	LINCOE X1,X2,Y1,Y2,A,B,C
04900	LINCOE X1,X3,Y1,Y3,LA,LB,LC	;COL-2
05000	HRR CC,A	;PACK c3
05100	HRL Y1,X1	;PACK X1,,Y1	;COL-3
05200	LINCOE X2,X3,Y2,Y3,KA,KB,KC	;COL-4
05300	P3D:
05400	;PACK EVERYTHING INTO YOUR OLD KIT BAG AND SMILE SMILE SMILE
05500	; WOULD YOU BELIEVE A LONG TRIANGLE BLOCK   
05600	HRL Y2,X2
05700	HRL Y3,X3
05800	MOVE AB2,LC
05900	MOVE AB3,C
06000	MOVE 2,13
06100	HRL 1,0
06200	HRL 3,14
06300	HRR 3,15
06400	MOVE 0,11
06500	EXCH 1,12
06600	EXCH 5,12
06700	MOVE 11,4
06800	MOVE 4,17
     

00100	;BLIT BLOCK INTO LONG BLOCK TABLE.
00200	MOVE 17,NLEAST
00300	IMULI 17,13
00400	ADDI 17,TRIBLKS
00500	MOVE 16,17
00600	ADDI 16,12
00700	BLT 17,@16
00800	P3E:
00900	;PUT TRIANGLE BLOCK POINTER INTO THE TRIANGLE TABLE
01000	;IN ORDER ON MINIMUM DEPTH.
01100		HRL ZT,Z
01200		MOVE TRI,NUMTRI
01300		SKIPN LO,NLEAST
01400		JRST [AOS NLEAST		;FIRST TIME ONLY.
01500			MOVEM ZT,TRITAB-1(TRI)
01600			JRST LOOP]
01700		SETZ HI,
01800	PUT1:	MOVE MID,LO	;MID:=(LO+HI+1)/2
01900		ADD MID,HI
02000		AOS MID
02100		ASH MID,-1
02200		MOVE LC,TRI	;FETCH Z(MID)
02300		SUB LC,MID
02400		HLRE A,TRITAB(LC)
02500		CAML Z,A
02600		JRST [CAMN LO,MID
02700			JRST PUT2
02800			CAMN HI,MID
02900			JRST PUT2
03000			MOVE LO,MID
03100			JRST PUT1]
03200		CAMN LO,MID
03300		JRST [AOS MID
03400			JRST PUT2]
03500		CAMN HI,LO
03600		JRST [AOS MID
03700			JRST PUT2]
03800		MOVE HI,MID
03900		JRST PUT1
04000	
04100	;MOVE THE LOWER PART OF THE TRIANGLE TABLE,
04200	;BETWEEN NLEAST AND MID,
04300	;DOWN CORE BY ONE WORD.
04400	
04500	PUT2:	CAMLE MID,NLEAST
04550		JRST PUT3
04575		MOVEI AC0,TRITAB
04600		ADD AC0,TRI
04700		MOVE AC1,AC0
04800		SUB AC0,NLEAST
04900		HRLS AC0
05000		SOS AC0
05100		SUB AC1,MID
05200		SOS AC1
05300		BLT AC0,@AC1
05400	PUT3:	AOS NLEAST
05500		SUB TRI,MID
05600		MOVEM ZT,TRITAB(TRI)
05700		JRST LOOP
05800	END